home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / manchest.lha / MANCHESTER / usenet / st80_pre4 / timeout.st < prev   
Text File  |  1993-07-24  |  14KB  |  366 lines
  1. "    NAME        timeout
  2.     AUTHOR        pieter@prls.UUCP (Pieter van der Meulen)
  3.     FUNCTION    timeouts for FillInTheBlank and BinaryChoice
  4.     ST-VERSION    2.3
  5.     PREREQUISITES    
  6.     CONFLICTS
  7.     DISTRIBUTION    world
  8.     VERSION        1
  9.     DATE    7 Apr 1989
  10. SUMMARY 
  11. This file implements a time-out mechanism for FillInTheBlanks
  12. and BinaryChoices.
  13. "
  14. '
  15. This file implements a time-out mechanism for FillInTheBlanks
  16. and BinaryChoices. After fileIn, try (i.e. printIt):
  17.  
  18.     "FillInTheBlank exampleTimeOut"
  19.     "BinaryChoice exampleTimeOut"
  20.  
  21. If you respond in time, they will operate like you would expect:
  22. they will return respectively a String and a Boolean value.
  23. If time-out occurs they will return respectively nil and a "message"
  24. in stead of a String and a Boolean value. However, some methods like
  25. (BinaryChoice class) <message:timeOut:onTimeOut:> allow you to specify
  26. aBlock to be executed "onTimeOut".
  27.  
  28. This code should work on both ParcPlace and Tektronix versions
  29. of Smalltalk, but no guarantees..... To beautify the code you could
  30. replace the lines containing "PP-V2.3" or "TB2.2.2a" to the code
  31. relevant to the version you are actually using.
  32. Some of the methods are quit similar to already available BinaryChoice
  33. and FillInTheBlanks methods, which resulted in long comments and
  34. long methods (and I definetely do not want to take credit for those).
  35.  
  36. If you modify these sources and feel it would be benificial to
  37. others who use this, or if you fix a bug, please send me the change:
  38.  
  39. Pieter S. van der Meulen    (UUCP: pieter@prls)
  40. Signetics div. of NAPC, MS 02
  41. 811 E. Arques Avenue.
  42. P.O.Box 3409
  43. Sunnyvale, California 94088-3409,USA'!
  44.  
  45.  
  46. BinaryChoiceController subclass: #TimedChoiceController
  47.     instanceVariableNames: 'timer timeOut '
  48.     classVariableNames: ''
  49.     poolDictionaries: ''
  50.     category: 'Interface-Prompt/Confirm'!
  51.  
  52. TimedChoiceController comment:
  53. 'I am implemented in order to allow TimeOut mechanisms
  54. in FillInTheBlanks and BinaryChoices.
  55.  
  56. I behave like the BinaryCoiceController, except that control
  57. is not only given up if the model responds true to the
  58. message actionTaken, but also if no response has been
  59. observed for a certain amount of time.
  60.  
  61. The TimeOut mechanism for FillInTheBlanks and BinaryChoices
  62. was written by Pieter S. van der Meulen."
  63.  
  64.  
  65. Instance variables:
  66.  
  67. timer        Implements a milli-seconds timer and is set to the current Time.
  68. timeOut    Specifies the amount of milli-seconds before TimeOut should take place.'!
  69.  
  70. !TimedChoiceController methodsFor: 'accessing'!
  71.  
  72. setTimer
  73.     "Set the timer to the current Time.
  74.     May be used to reset the timeOut."
  75.  
  76.     timer _ Time millisecondClockValue!
  77.  
  78. timeLeft
  79.     "Return the number of milliSeconds left till timeOut.
  80.     Return exactly zero if the timers are not initialized,
  81.     in which case I will act like BinaryChoiceController."
  82.  
  83.     (timeOut isNil or: [timer isNil]) ifTrue: [^0].
  84.     ^timeOut - Time millisecondClockValue + timer!
  85.  
  86. timeOut: milliSec
  87.     "Do not allow any timeOut shorter than 1 second or longer that 1 minute.
  88.     You may want to overwrite this, but be careful: Users may think they are
  89.     dealing with seconds in stead of milli-seconds."
  90.  
  91.     timeOut _ (milliSec max: 1000) min: 60000! !
  92.  
  93. !TimedChoiceController methodsFor: 'control defaults'!
  94.  
  95. isControlActive
  96.     self timeLeft < 0 ifTrue: [^false].
  97.     model actionTaken ifTrue: [^false].
  98.     (view containsPoint: sensor cursorPoint) ifFalse: [view flash].
  99.     ^true! !
  100.  
  101. !BinaryChoiceView class methodsFor: 'private'!
  102.  
  103. buildSwitchesFor: aBinaryChoice width: anInteger timeOut: milliSeconds
  104.     "This method should work on both PP and Tek versions of Smalltalk,
  105.     but in order to enable that we have to do some obscure coding.
  106.     The TimeOut mechanism was written by Pieter S. van der Meulen."
  107.  
  108.     |switchView yesSwitchView noSwitchView|
  109.     switchView _ View new model: aBinaryChoice.
  110.     switchView controller: TimedChoiceController new.
  111.     switchView controller timeOut: milliSeconds.
  112.     yesSwitchView _ SwitchView new model: aBinaryChoice.
  113.     yesSwitchView borderWidthLeft: 0 right: 2 top: 0 bottom: 0.
  114.     yesSwitchView selector: #active.
  115.     yesSwitchView controller selector: #selectTrue.
  116.     yesSwitchView controller cursor:
  117.         ((Cursor respondsTo: #thumbsUp)
  118.             ifTrue: [Cursor thumbsUp]                "PP-V2.3"
  119.             ifFalse: [classPool at: #ThumbsUp]).    "TB2.2.2a"
  120.     yesSwitchView label: 'yes' asParagraph.
  121.     yesSwitchView window: (0@0 extent: anInteger//2 @ yesSwitchView window height).
  122.     noSwitchView _ SwitchView new model: aBinaryChoice.
  123.     noSwitchView selector: #active.
  124.     noSwitchView controller selector: #selectFalse.
  125.     noSwitchView controller cursor:
  126.         ((Cursor respondsTo: #thumbsUp)
  127.             ifTrue: [Cursor thumbsDown]                "PP-V2.3"
  128.             ifFalse: [classPool at: #ThumbsDown]).    "TB2.2.2a"
  129.     noSwitchView label: 'no' asParagraph.
  130.     noSwitchView window: (0@0 extent: anInteger//2 @ noSwitchView window height).
  131.     switchView addSubView: yesSwitchView.
  132.     switchView addSubView: noSwitchView toRightOf: yesSwitchView.
  133.     switchView borderWidthLeft: 0 right: 0 top: 2 bottom: 0.
  134.     ^switchView! !
  135.  
  136. !BinaryChoiceView class methodsFor: 'instance creation'!
  137.  
  138. openOn: aBinaryChoice message: messageString displayAt: originPoint centered: centered timeOut: milliSeconds
  139.     "Answer an instance of me that displays aBinaryChoice asking the question
  140.     messageString.  If the argument centered, a Boolean, is false, display the instance
  141.     with top left corner at originPoint;  otherwise, display it with its center at
  142.     originPoint.  If necessary, translate so the view is completely on the screen.
  143.     Do not schedule, rather take control immediately and insist that the user respond.
  144.     If the user waits longer than anInteger seconds, return nil.
  145.     The TimeOut mechanism was written by Pieter S. van der Meulen."
  146.  
  147.     | topView messageView switchView savedArea |
  148.     messageView _ ((DisplayTextView respondsTo: #editParagraph:)
  149.         ifTrue: [DisplayTextView new editParagraph: messageString asParagraph]    "PP-V2.3"
  150.         ifFalse: [DisplayTextView new model: messageString asDisplayText]).        "TB2.2.2a"
  151.     messageView insideColor: Form white.
  152.     messageView controller: NoController new.
  153.     messageView centered.
  154.     switchView _ self
  155.         buildSwitchesFor: aBinaryChoice
  156.         width: messageView window width
  157.         timeOut: milliSeconds.
  158.     topView _ self new model: aBinaryChoice.
  159.     topView addSubView: messageView.
  160.     topView addSubView: switchView below: messageView.
  161.     topView
  162.         align: (centered
  163.                 ifTrue: [switchView viewport center]
  164.                 ifFalse: [topView viewport topLeft])
  165.         with: originPoint.
  166.     topView borderWidth: 2.
  167.     topView translateBy:
  168.         (topView displayBox amountToTranslateWithin: Display boundingBox).
  169.     topView insideColor: Form white.
  170.     savedArea _ Form fromDisplay: topView displayBox.
  171.     topView display.
  172.     switchView controller setTimer.
  173.     topView controller: TimedChoiceController new.
  174.     topView controller timeOut: milliSeconds.
  175.     topView controller setTimer; startUp.
  176.     topView release.
  177.     savedArea displayOn: Display at: topView viewport topLeft! !
  178.  
  179. !BinaryChoice class methodsFor: 'instance creation'!
  180.  
  181. message: messageString displayAt: aPoint centered: centered ifTrue: trueAlternative ifFalse: falseAlternative timeOut: milliSeconds
  182.     "Answer an instance of me whose question is messageString.  If the user
  183.     answer is yes, then evaluate trueAlternative.  If the user answer is no,
  184.     evaluate falseAlternative. If centered, a Boolean, is false, display the view of the
  185.     instance at aPoint; otherwise display it with its center at aPoint.
  186.     If the user waits longer than anInteger seconds, return nil.
  187.     The TimeOut mechanism was written by Pieter S. van der Meulen."
  188.  
  189.     | newChoice |
  190.     newChoice _ self new initialize.
  191.     newChoice trueAction: trueAlternative.
  192.     newChoice falseAction: falseAlternative.
  193.     BinaryChoiceView
  194.         openOn: newChoice
  195.         message: messageString
  196.         displayAt: aPoint
  197.         centered: centered
  198.         timeOut: milliSeconds!
  199.  
  200. message: messageString timeOut: milliSeconds onTimeOut: aBlock
  201.     "Answer an instance of me whose question is messageString.  If the user
  202.     answer is yes, then return true.  If the user answer is no, return false.  
  203.     Display the view of the instance at the cursor location.
  204.     If the user waits longer than anInteger seconds, evaluate aBlock and
  205.     return the result.
  206.     The TimeOut mechanism was written by Pieter S. van der Meulen."
  207.  
  208.     | answer |
  209.     self message: messageString
  210.         displayAt: Sensor cursorPoint
  211.         centered: true
  212.         ifTrue: [answer _ true]
  213.         ifFalse: [answer _ false]
  214.         timeOut: milliSeconds.
  215.     answer isNil ifTrue: [^aBlock value].
  216.     ^answer!
  217.  
  218. message: messageString timeOut: milliSeconds
  219.     "Answer an instance of me whose question is messageString.  If the user
  220.     answer is yes, then return true.  If the user answer is no, return false.  
  221.     Display the view of the instance at the cursor location.
  222.     If the user waits longer than anInteger seconds, return nil.
  223.     The TimeOut mechanism was written by Pieter S. van der Meulen."
  224.  
  225.     | answer |
  226.     self
  227.         message: messageString
  228.         displayAt: Sensor cursorPoint
  229.         centered: true
  230.         ifTrue: [answer _ true]
  231.         ifFalse: [answer _ false]
  232.         timeOut: milliSeconds.
  233.     ^answer! !
  234.  
  235. !BinaryChoice class methodsFor: 'examples'!
  236.  
  237. exampleTimeOut
  238.  
  239.     ^BinaryChoice
  240.         message: 'Do you have quick reflexes' 
  241.         timeOut: 1000
  242.         onTimeOut: ['I gues not :-)']
  243.  
  244.     "BinaryChoice exampleTimeOut."! !
  245.  
  246. CRFillInTheBlankController subclass: #TCRFillInTheBlankController
  247.     instanceVariableNames: ''
  248.     classVariableNames: ''
  249.     poolDictionaries: ''
  250.     category: 'Interface-Prompt/Confirm'!
  251.  
  252. TCRFillInTheBlankController comment:
  253. 'The T stands for TimeOut: I am implemented in order
  254. to allow time-out mechanisms in FillInTheBlanks.
  255.  
  256. I overwrite the <isControlActive> method of my superClass.
  257. Assuming my view has a superView, I check wether that
  258. superViews controller <isControlActive> and if it is not,
  259. I consider myself also as not active anymore.
  260. This is true, even if my model has not taken any action yet.
  261.  
  262. The TimeOut mechanism for FillInTheBlanks and BinaryChoices
  263. was written by Pieter S. van der Meulen.'!
  264.  
  265. !TCRFillInTheBlankController methodsFor: 'control defaults'!
  266.  
  267. isControlActive
  268.     view superView controller isControlActive ifFalse: [^false].
  269.     ^super isControlActive! !
  270.  
  271. !FillInTheBlankView class methodsFor: 'instance creation'!
  272.     "Answer an instance of me on the model aFillInTheBlank asking the
  273.     question messageString. If the argument centered, a Boolean, is false,
  274.     display the instance with top left corner at originPoint; otherwise,
  275.     display it with its center at originPoint.  If necessary, translate so
  276.     the view is completely on the screen. If the user waits longer than
  277.     anInteger seconds, return nil.
  278.     The TimeOut mechanism was written by Pieter S. van der Meulen."
  279.  
  280. on: aFillInTheBlank message: messageString displayAt: originPoint centered: centered useCRController: useCRController timeOut: milliSeconds
  281.  
  282.     | topView messageView answerView |
  283.     messageView _ self buildMessageView: messageString.
  284.     answerView _ 
  285.         self buildAnswerView: aFillInTheBlank 
  286.             frameWidth: messageView window width.
  287.     useCRController ifTrue: [answerView controller: TCRFillInTheBlankController new].
  288.     topView _ View new model: aFillInTheBlank.
  289.     topView controller: TimedChoiceController new.
  290.     topView controller timeOut: milliSeconds.
  291.     topView addSubView: messageView.
  292.     topView addSubView: answerView below: messageView.
  293.     topView align: (centered
  294.             ifTrue: [topView viewport center]
  295.             ifFalse: [topView viewport topLeft])
  296.         with: originPoint.
  297.     topView window: 
  298.         (0 @ 0 extent: 
  299.             messageView window width @ 
  300.             (messageView window height + answerView window height)).
  301.     topView translateBy:
  302.         (topView displayBox amountToTranslateWithin: Display boundingBox).
  303.     ^topView! !
  304.  
  305. !FillInTheBlank class methodsFor: 'instance creation'!
  306.  
  307. request: messageString displayAt: aPoint centered: centered action: aBlock initialAnswer: aString useCRController: useCRController timeOut: milliSeconds
  308.     "Answer an instance of me whose question is messageString.
  309.     Once the user provides an answer, then evaluate aBlock.
  310.     If centered, a Boolean, is false, display the view of the instance
  311.     at aPoint; otherwise display it with its center at aPoint.
  312.     If the user waits longer than anInteger seconds, return nil.
  313.     The TimeOut mechanism was written by Pieter S. van der Meulen."
  314.  
  315.     | newBlank fillInView savedArea |
  316.     newBlank _ self new initialize.
  317.     newBlank action: aBlock.
  318.     newBlank contents: aString.
  319.     fillInView _ 
  320.         FillInTheBlankView
  321.             on: newBlank
  322.             message: messageString
  323.             displayAt: aPoint
  324.             centered: centered
  325.             useCRController: useCRController
  326.             timeOut: milliSeconds.
  327.     savedArea _ Form fromDisplay: fillInView displayBox.
  328.     fillInView display.
  329.     fillInView controller setTimer; centerCursorInView.
  330.     fillInView controller startUp.
  331.     fillInView release.
  332.     savedArea displayOn: Display at: fillInView viewport topLeft!
  333.  
  334. request: messageString initialAnswer: aString timeOut: milliSeconds
  335.     "Create an instance of me whose question is messageString.
  336.     Display it centered around the cursor.
  337.     Supply aString as an initial answer.
  338.     Simply return whatever the user accepts."
  339.  
  340.     | response |
  341.     self request: messageString
  342.         displayAt: Sensor cursorPoint
  343.         centered: true
  344.         action: [:resp | response _ resp]
  345.         initialAnswer: aString
  346.         useCRController: true
  347.         timeOut: milliSeconds.
  348.     ^response!
  349.  
  350. request: messageString timeOut: milliSeconds
  351.     "Create an instance of me whose question is messageString.
  352.     Display it centered around the cursor.
  353.     Simply return whatever the user accepts."
  354.  
  355.     ^self request: messageString initialAnswer: '' timeOut: milliSeconds! !
  356.  
  357. !FillInTheBlank class methodsFor: 'examples'!
  358.  
  359. exampleTimeOut
  360.     "FillInTheBlank exampleTimeOut."
  361.  
  362.     ^FillInTheBlank
  363.         request: 'This message will self destruct after 5 seconds'
  364.         initialAnswer: 'or if you hit return here......'
  365.         timeOut: 5000! !
  366.